perm filename NTS2.F4[P11,LCS] blob
sn#583809 filedate 1981-05-02 generic text, type T, neo UTF8
C**** NTS2.F4, NTAIL *********
SUBROUTINE NTS2
COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,PUNCT,JY,RJ
EQUIVALENCE (J5,JQ(3)),(R4,RJQ(2)),(J7,JQ(5)),(J10,JQ(8)),
1(J6,JQ(4)),(R5,RJQ(3)) ,(R8,RJQ(6)),(R3,RJQ(1))
1,(RX4,JQ(19)),(JSTEM,JQ(20))
R5=R5-J5
IF(JSTEM.EQ.0)RETURN
C RB R5=STEPS TO LEFT FOR ACCID. (.1=1 STEP)
IF(L.LT.280)RB=CENTR+RZTM
C ≥280 IS FOR 'X' NOTES.
128 J7=MOD(J7,10)
RG=(J7-1)*14
IF(RG.LT.0)RG=0
C 999 IS STANDARD (0) STEM LENGTH.
IF(R8.NE.999.)GO TO 1751
R8=0
RH=0
GO TO 2751
1751 IF(R8.LT.999.)GO TO 751
R8=R8-1000.
J10=-1
C WAS R10=-1 TO MAKE GRACE NOTE SLASH
C 1000+ PUTS SLASH ON NOTE STEM
751 RH=R8*RST7
2751 J5=MOD(J5,10)
C ACCI NOW IN J5
IF(JSTEM.NE.2)GO TO 1280
C STEM EXTENSIONS ARE BY NOTE #S
RJX=R3
C FOR STEM DOWN (=2)
RG=-RG-48.
RH=-RH
RB=RB-RZTM*2
C FOR TILT OF ORDINARY NOTES (NOT X OR DIAMOND)
GO TO 129
C NEXT IS FOR STEM UP.
1280 RJX=WID1
IF(J6.LT.0)RJX=WID2
C IF(J6.LT.0)GET SPACE FOR HALF NOTE
2322 RJX=RJX*RMINI+R3
RG=RG+48.
129 RZ=CENTR+RH+RG*RMINI
IF(RMINI.NE.RSTJ2)RJW=RJW*.6
CALL LINX(RJX,RB,RJX,RZ)
C RB HERE IS CENTR (FOR 'X' NOTES OR NOT)
C J5 HAS ACCID. # NOW
IF(J7.LE.0)RETURN
C JUMP IF NO TAILS
CALL NTAIL
327 IF(R4.GE.RX4)RX4=R4+1
C FOR TRILLS, ETC.
IF(J10.GE.0)RETURN
RJY=RZ-19.*RSTJ2
RZ=RZ-RSTJ2*4.
IF(RA.LT.0)GO TO 1327
C NEXT IS FOR STEM DOWN SLASH
RJY=RZ+23*RSTJ2
RZ=RZ+RST7
1327 RJX=RJX-RST7
CALL LINX(RJX,RJY,RJX+17.*RSTJ2,RZ)
C FOR SLASH ON GRACE NOTE TAIL
END
SUBROUTINE NTAIL
COMMON /STF/RSTFAC(0/7),RSTJ2
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,PUNCT,JY,RJ
EQUIVALENCE (R4,RJQ(2)),(J7,JQ(5)) ,(R8,RJQ(6)),(R3,RJQ(1))
1,(JSTEM,JQ(20))
RJW=2.*RMINI/RSTJ2
RA=1.
C FOR VERT. SPACING OF MULTIPLE TAILS
IF(JSTEM.NE.2)GO TO 1127
R4=R4-3.7-R8
C R4 IS USED IN SUBR. TAIL - R8 IS STEM EXTENSION.
RJW=-RJW
GO TO 127
1127 R4=R4-2+R8
RA=-RA
R8=0
C FOR SHIFT AT 246
127 CALL TAIL
J7=J7-1
IF(J7.EQ.0)RETURN
R4=R4+RJW
GO TO 127
C MOVES CENTR UP OR DOWN FOR NEXT TAIL
END